Option Strict Off
Option Explicit On
Module CaptureRoutine
	
	'**************************VERY IMPORTANT*******************************
	'IF YOU COPY THIS INTO A PROJECT IT WONT WORK IMMEDIATELY
	'YOUR PROJECT NEEDS TO BE POINTED TO THE TYPE LIBRARY.
	'COPY THE gdi+.tlb TO THE SYSTEM32 DIRECTORY THEN
	'IN VISUAL BASIC TOP MENUS , PROJECT > REFERENCES > BROWSE > BROWSE TO THE gdi+.tlb AND CLICK OPEN
	'NOW IN THE LIST BROWSE DOWN TO THE FILENAME gdi+.tlb AND CLICK IT ON.
	'**************************VERY IMPORTANT*******************************
	
	
	Private gdip1 As cGdiPlus
	
	
	
	
	Public Sub Capture()
		On Error GoTo ErrorHandling 'If an error occurs go to the error handling routine
		ErrPnt(("2.00"))
		IsCapturing = True 'Set true to show program is in capturing / saving mode
		If WindowAtFront = "PlayBack" Then Call Toggle() 'The program is in playback mode, so toggle to live mode before capturing
		frmCapture.picLive.Refresh()
		Dim Xa As Integer
		Dim Ya As Integer
		Dim NumItt As Short
		Dim FrameID As String
		Dim LoopCnt3 As Integer
		
		If SoundsOnOff = True Then 'Check if the user wants sound
			Call CameraShutter() 'Play the sound of the camera shutter (See APISound module)
		End If
		
		
		
		frmAveraging.Text = "Frame Averaging -   " & FrameAvgDepth & " Frames at " & FrameAvgDelay & " millisecond intervals"
		
		If WindowAtFront = "PlayBack" Then
			PlayStatus = "Stopped"
			PlayBackMediaControl.Pause()
		End If
		
		frmCapture.picLive.Visible = True
		frmCapture.picPlayBack.Visible = False
		WindowAtFront = "Live" 'Set the variable that live window is at the front
		
		
		ErrPnt(("02.01"))
		'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
		If Dir(Left(SavePath, Len(SavePath) - 1), FileAttribute.Directory) = "" Then 'If the Destination directory does not exist, create it
			MkDir((Left(SavePath, Len(SavePath) - 1))) 'The new directory name is the SavePath variable with the trailing \ removed
		End If
		
		AlphaFlags.BlendOp = &H0 : AlphaFlags.BlendFlags = 0 : AlphaFlags.AlphaFormat = 0
		
		ErrPnt(("02.02")) 'Set an error code for the next section of program

        Dim avgGraph As Graphics = frmAveraging.picAverage.CreateGraphics
        Dim avgHDC As IntPtr = avgGraph.GetHdc

        Dim rawGraph As Graphics = frmAveraging.picRaw.CreateGraphics
        Dim rawHDC As IntPtr = rawGraph.GetHdc

        Dim onion1Graph As Graphics = frmAveraging.picOnion1.CreateGraphics
        Dim onion1HDC As IntPtr = onion1Graph.GetHdc

		'Now perform frame averaging to improve the quality of the image.
		For NumItt = 1 To FrameAvgDepth




            PauseDelayMilliSec((FrameAvgDelay))
			System.Windows.Forms.Application.DoEvents()
			ErrPnt(("2.02b"))
			'UPGRADE_ISSUE: PictureBox property picRaw.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
            CopyCamToPic((frmAveraging.picRaw))
			'UPGRADE_ISSUE: PictureBox property picRaw.Image was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
			frmAveraging.picRaw.Image = frmAveraging.picRaw.Image
			ErrPnt(("2.02c"))
			AlphaFlags.SourceConstantAlpha = Int(255 / NumItt) 'original value was 128 reducing makes source overlay more transparent
			'UPGRADE_WARNING: Couldn't resolve default property of object AlphaFlags. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
			Call RtlMoveMemory(AlphaFlagsAsLong, AlphaFlags, 4) 'copy the BLENDFUNCTION-structure to a Long as Alpha blend only accepts a long value not a flag array
			ErrPnt(("2.02d"))
			'UPGRADE_ISSUE: PictureBox property picRaw.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
			'UPGRADE_ISSUE: PictureBox property picAverage.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
            Call AlphaBlend(avgHDC, 0, 0, CaptureWidth, CaptureHeight, rawHDC, 0, 0, CaptureWidth, CaptureHeight, AlphaFlagsAsLong)
			'UPGRADE_ISSUE: PictureBox property picAverage.Image was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
			frmAveraging.picAverage.Image = frmAveraging.picAverage.Image
			frmAveraging.picRaw.Refresh()
			frmAveraging.picAverage.Refresh()
			ErrPnt(("2.02e"))
			If FrameNumberStampYesNo = True Then 'If the user wants to have the frame number stamped on the bitmap
				'UPGRADE_ISSUE: PictureBox property picAverage.CurrentX was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
                'frmAveraging.picAverage.CurrentX = 5
				'UPGRADE_ISSUE: PictureBox property picAverage.CurrentY was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
                'frmAveraging.picAverage.CurrentY = 5
				FrameID = LTrim(Str(FrameNum + 1))
				If Len(FrameID) = 1 Then FrameID = "00000" & FrameID
				If Len(FrameID) = 2 Then FrameID = "0000" & FrameID
				If Len(FrameID) = 3 Then FrameID = "000" & FrameID
				If Len(FrameID) = 4 Then FrameID = "00" & FrameID
				If Len(FrameID) = 5 Then FrameID = "0" & FrameID
				
                Dim g As Graphics = Graphics.FromImage(frmAveraging.picAverage.Image)
                Dim drawFont As New Font("Arial", 10)
                Dim drawBrush As New SolidBrush(Color.Black)
                g.DrawString("Frame " & FrameID, drawFont, drawBrush, 5, 5)
                'UPGRADE_ISSUE: PictureBox method picAverage.Print was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
                'frmAveraging.picAverage.Print("Frame " & FrameID)


			End If
		Next NumItt
		ErrPnt(("2.02y"))
		
		
		Call ActionChromaKeying((frmAveraging.picAverage)) 'Call ChromaKeying if required

        Const vbWhiteness As Integer = 16
        Const vbSrcCopy As Integer = 13369376


		'UPGRADE_ISSUE: Constant vbWhiteness was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="55B59875-9A95-4B71-9D6A-7C294BF7139D"'
		'UPGRADE_ISSUE: PictureBox property picOnion1.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
        Call BitBlt(onion1HDC, 0, 0, CaptureWidth, CaptureHeight, 0, 0, 0, vbWhiteness) 'before we can blit to the buffer, we should fill it with black
		'UPGRADE_ISSUE: Constant vbSrcCopy was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="55B59875-9A95-4B71-9D6A-7C294BF7139D"'
		'UPGRADE_ISSUE: PictureBox property picAverage.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
		'UPGRADE_ISSUE: PictureBox property picOnion1.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
        Call BitBlt(onion1HDC, 0, 0, CaptureWidth, CaptureHeight, avgHDC, 0, 0, vbSrcCopy) 'copy the averaged image to the onion buffer

        avgGraph.ReleaseHdc(avgHDC)
        avgGraph.Dispose()

        rawGraph.ReleaseHdc(rawHDC)
        rawGraph.Dispose()

        onion1Graph.ReleaseHdc(onion1HDC)
        onion1Graph.Dispose()

		ErrPnt(("2.02z"))
		System.Windows.Forms.Application.DoEvents()
		
		ErrPnt(("2.03"))
		'******************Bitmap to Jpeg compression start*******************************
		gdip1 = New cGdiPlus 'Define a instance of a class to enable saving of image.
		Result = gdip1.PictureBoxToFile(frmAveraging.picAverage, My.Application.Info.DirectoryPath & "\LastFrame.jpg", CaptureQuality) 'Use the instance to save a jpeg at the requested quality
		'UPGRADE_NOTE: Object gdip1 may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		gdip1 = Nothing 'Clean up the instance to free memory                                                 'Erase the class structure to clean up
		'******************Bitmap to Jpeg compression end*********************************
		
		
		Dim hFile As Integer
		For LoopCnt3 = 1 To NumFramesPerClick 'Loop round saving multiple frames if required
			
			ErrPnt(("2.04"))
			Call RemoveDShowPlayBack() 'Remove the video from the playback window to free the .avi file for writing
			
			ErrPnt(("2.05"))
			FunctionOK = AppendMJpeg(SavePath & ProjName & ".avi", My.Application.Info.DirectoryPath & "\LastFrame.jpg", FPS, CaptureWidth, CaptureHeight) 'Append the JPEG image to the AVI file. Creates file if necessary.
			
			
			'The next section tries to overcome an error on some systems. I suspect a lockup occurs because the disk write for the .avi file doesn't finish on some systems before the program
			'tries to load it to the media player, and it fails. The solution is to check file access and only continue when it it available.
			
			
WaitForFileToFinish: 
			'check if file can be accesed
			hFile = CreateFile(SavePath & ProjName & ".avi", &H80000000, 0, 0, 3, &H80, 0)
			Result = hFile = -1 'this will evaluate to either     -1 (FILE_IN_USE) or 0 (FILE_FREE)
			CloseHandle(hFile)
			
			If Result = -1 Then GoTo WaitForFileToFinish : 'The avi file hasn't finished writing, so loop until it has before loading to the .avi file
			
			ErrPnt(("2.05a"))
			
			If FunctionOK = False Then 'The program failed to append the file.
				FunctionOK = OpenDShowPlayBack(SavePath & ProjName & ".avi", (frmCapture.picPlayBack)) 'Load the unmodified video back in the playback window
				IsCapturing = False 'Set false to show program has finished capturing / saving mode
				Exit Sub
			End If
			
			ErrPnt(("2.06"))
			
			If FunctionOK = True Then FrameNum = FrameNum + 1 'The file was appended ok, so increase the frame count
			
			FrameID = LTrim(Str(FrameNum))
			If Len(FrameID) = 1 Then FrameID = "00000" & FrameID
			If Len(FrameID) = 2 Then FrameID = "0000" & FrameID
			If Len(FrameID) = 3 Then FrameID = "000" & FrameID
			If Len(FrameID) = 4 Then FrameID = "00" & FrameID
			If Len(FrameID) = 5 Then FrameID = "0" & FrameID
			
			
			ErrPnt(("2.07"))
			'***********Bmp Output******************************************
			If OutputBmpFramesYesNo = True Then 'If the settings box is checked to save individual bitmap frames (see frmSettings)
				FrameString = SavePath & ProjName & "_Frame_" & FrameID & ".bmp" 'Generate the filename where the bitmap image is to be saved to
				'UPGRADE_WARNING: SavePicture was upgraded to System.Drawing.Image.Save and has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
				frmAveraging.picAverage.Image.Save(FrameString) 'save the averaged image to file . The saved image will be the same size as that from the camera.
			End If
			'***********Bmp Output******************************************
			
			'***********Jpeg Output******************************************
			If OutputJpgFramesYesNo = True Then 'If the settings box is checked to save individual jpeg frames (see frmSettings)
				FrameString = SavePath & ProjName & "_Frame_" & FrameID & ".jpg" 'Generate the filename where the bitmap image is to be saved to
				gdip1 = New cGdiPlus 'Define a instance of a class to enable saving of image.
				Result = gdip1.PictureBoxToFile(frmAveraging.picAverage, FrameString, JpegQuality) 'Use the instance to save a jpeg at the requested quality
				'UPGRADE_NOTE: Object gdip1 may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
				gdip1 = Nothing 'Clean up the instance to free memory
			End If
			'***********Jpeg Output******************************************
			
			'***********PNG Output******************************************
			If OutputPngFramesYesNo = True Then 'If the settings box is checked to save individual png frames (see frmSettings)
				FrameString = SavePath & ProjName & "_Frame_" & FrameID & ".png" 'Generate the filename where the bitmap image is to be saved to
				gdip1 = New cGdiPlus 'Define a instance of a class to enable saving of image.
				Result = gdip1.PictureBoxToFile(frmAveraging.picAverage, FrameString) 'Use the instance to save a jpeg at the requested quality
				'UPGRADE_NOTE: Object gdip1 may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
				gdip1 = Nothing 'Clean up the instance to free memory
			End If
			'***********PNG Output******************************************
			
			'***********Gif Output******************************************
			If OutputGifFramesYesNo = True Then 'If the settings box is checked to save individual gif frames (see frmSettings)
				FrameString = SavePath & ProjName & "_Frame_" & FrameID & ".gif" 'Generate the filename where the bitmap image is to be saved to
				gdip1 = New cGdiPlus 'Define a instance of a class to enable saving of image.
				Result = gdip1.PictureBoxToFile(frmAveraging.picAverage, FrameString) 'Use the instance to save a jpeg at the requested quality
				'UPGRADE_NOTE: Object gdip1 may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
				gdip1 = Nothing 'Clean up the instance to free memory
			End If
			'***********Gif Output******************************************
			
			'***********Tif Output******************************************
			If OutputTifFramesYesNo = True Then 'If the settings box is checked to save individual tif frames (see frmSettings)
				FrameString = SavePath & ProjName & "_Frame_" & FrameID & ".tif" 'Generate the filename where the bitmap image is to be saved to
				gdip1 = New cGdiPlus 'Define a instance of a class to enable saving of image.
				Result = gdip1.PictureBoxToFile(frmAveraging.picAverage, FrameString) 'Use the instance to save a jpeg at the requested quality
				'UPGRADE_NOTE: Object gdip1 may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
				gdip1 = Nothing 'Clean up the instance to free memory
			End If
			'***********Tif Output******************************************
			
			ErrPnt(("02.08"))
			'****************Advance rotoscope window*********
			If RotoScopeLoadedYesNO = False Then GoTo NoRotoscopeAdvance : 'Theres no film loaded in the rotoscope, so dont advance it
			If RotoScopeSyncYesNo = False Then GoTo NoRotoscopeAdvance : 'The sync is switched off so dont advance the rotoscope
			RotoScopeMediaControl.Pause() 'stop it if its playing
			If RotoScopeMediaPosition.CurrentPosition + (1 / FPS) > RotoScopeMediaPosition.Duration Then 'Check if this will take it past end of the .avi
				GoTo NoRotoscopeAdvance
			Else
				RotoScopeMediaPosition.CurrentPosition = RotoScopeMediaPosition.CurrentPosition + (1 / FPS)
			End If
NoRotoscopeAdvance: 
			
			ErrPnt(("2.09"))
			If XSheetActiveYesNo = True Then 'if the exposure sheet is showing advance it
				ExposureTopPos = FrameNum 'set the top position of the exposure sheet to the frame
				Call frmXSheet.ReloadExposureSheet(ExposureTopPos)
			End If
			
		Next LoopCnt3
		
		'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
		If Dir(My.Application.Info.DirectoryPath & "\LastFrame.jpg") <> "" Then Kill((My.Application.Info.DirectoryPath & "\LastFrame.jpg")) 'Erase the temporary lastframe captured store
		
		ErrPnt(("2.10"))
		If ShutterMacroYesNo = True Then 'The user wants the program to trigger an external camera shutter
			Call TriggerCameraShutter() 'Call the shutter macro program
		End If
		'   Beep
		FunctionOK = OpenDShowPlayBack(SavePath & ProjName & ".avi", (frmCapture.picPlayBack)) 'Load the video back in the playback window
		Beep()
		
		IsCapturing = False 'Set false to show program has finished capturing / saving mode
		ErrPnt(("2.99"))
		On Error GoTo 0 'Set error handling so it doesnt return here.
		
		Exit Sub 'Exit the subroutine
		
		'***********************************************************************************************************************************************
ErrorHandling: 
		ErrorDescription = "Capture Routine Problem"
		Call frmErrorBox.ErrorMessageBox() 'Put up a message Box
		Call ExitProgram() 'Exit the Program gracefully
	End Sub
End Module